home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / index.arc / AEGETREC.BAS < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  2.5 KB  |  77 lines
  1. rem $linesize:132
  2. rem $title:'Application Engineer Standard Routines'
  3. rem $subtitle:'Allocate and return next available record number'
  4. '                Include the COMMON values
  5. rem $include:'AESHARED.BAS'            
  6.     
  7. sub Get.Avail.Record (fl%,rlen%,rec%) static
  8.  
  9.         r%=rlen%-8%                      '  Rest of the record
  10.  
  11.         field #fl%,1 as stat$,2 as n.av$,2 as l.av$,1 as mj$,1 as mn$,1 as bug.fix$
  12.         field #fl%,8 as dummy$,r% as filler$
  13.  
  14. '  stat$    =  Status (1 = Open / 2 = Closed)
  15. '  n.av$    =  Next available record
  16. '  l.av$    =  Last available record
  17. '  mj$      =  Application Engineer Major release version
  18. '  mn$      =  Application Engineer Minor release version
  19. '  bug.fix$ =  Bug fix code within Minor release
  20.  
  21.         get #fl%,1%
  22.  
  23.         if mj$<>chr$(0%) or _
  24.             mn$<>chr$(0%) or _
  25.             bug.fix$<>"B" _
  26.         then
  27.             call ae.error("GAR Version mismatch error. Action 01")
  28.         end if
  29.  
  30.         nav%=cvi(n.av$)
  31.         lav%=cvi(l.av$)
  32.  
  33.         field #fl%,2 as pt$,r%+6% as filler$
  34.         get #fl%,nav%
  35.  
  36.         npt%=cvi(pt$)
  37.  
  38.         if npt%=0% then
  39.             call ae.error("GAR File corruption error. Action 02")
  40.         end if
  41.  
  42.  
  43.         if npt%=-1% then
  44.             if nav%<>lav% then
  45.                 call ae.error("GAR File corruption error. Action 03")
  46.             end if
  47.  
  48.             if lav%=32767% then        ' Maximum file size is 32767
  49.                 call ae.error("GAR File full error. Action 04")
  50.             end if
  51.  
  52.             lav%=lav%+1%               '  Increment the last avail to filelen + 1
  53.             rec%=nav%                  '  Hold the available record number
  54.             lset pt$=mki$(0%)          '  Set the status to USED
  55.             put #fl%,nav%              '  Put the record back
  56.             nav%=lav%                  '  Set the next avail to last avail
  57.             lset pt$=mki$(-1%)         '  Set status to END OF CHAIN
  58.             put #fl%,nav%              '  Put the new next avail
  59.             get #fl%,1%                '  Get the header information
  60.             lset n.av$=mki$(nav%)      '  Set the new next avail
  61.             lset l.av$=mki$(lav%)      '  Set the new last avail
  62.             put #fl%,1%                '  Put the header information back
  63.         end if
  64.  
  65.  
  66.         if npt%<>-1% then             '  There are more records on file
  67.             rec%=nav%                  '  Hold the avaialable record number
  68.             lset pt$=mki$(0%)          '  Set the status to used
  69.             put #fl%,nav%              '  Put the record back
  70.             nav%=npt%                  '  Next available record chain
  71.             get #fl%,1%                '  Get the header information
  72.             lset n.av$=mki$(nav%)      '  Set the new next avail
  73.             put #fl%,1%                '  Put the header information back
  74.         end if
  75.  
  76.     end sub
  77.